perm filename SAY.SAI[4,ALS] blob
sn#058559 filedate 1973-08-17 generic text, type T, neo UTF8
00010 BEGIN "SAY"
00020 DEFINE ⊂="COMMENT"; ⊂ 7/31/73 Runs SIG from FIX output;
00030
00040 REQUIRE "SIG" LOAD_MODULE;
00050 REQUIRE "BLOCKS.HDR" SOURCE_FILE;
00060 EXTERNAL FORTRAN PROCEDURE SIG(REFERENCE INTEGER P);
00070 INTEGER ARRAY LFILE[0:'177];
00080 INTERNAL INTEGER ARRAY INDATA[0:4000];
00090 INTERNAL INTEGER H,I,J,K,L,M,N,P,NF;
00100 INTERNAL INTEGER FLAG,CFLAG,RFLAG,UPCNT,TABTOT;
00110 INTERNAL INTEGER SEGC,INTOT,SEGTOT,HINT,BPT,PHW,SMOCNT,SMCNT2,ZCNT;
00120 INTEGER NEW,OLD,SUM,S1,S2,S3,S4,RL;
00130 INTEGER ARRAY N1[0:3];
00140 INTEGER HINCNT,HCOUNT,HINDEX,EOF,EOFA,EOFB,BRK;
00150 INTEGER CHAN1,CHAN2,CHAN3,CHAN4,CHAN5,CHAN6;
00160 STRING READ1,FILEL,FILEI,TFILE,TFILEI,FILLST,PREHINT;
00170 DEFINE ARRSIZ="4096";
00180 INTERNAL INTEGER ARRAY LRN[0:ARRSIZ];
00190 INTERNAL INTEGER ARRAY RES,USE[0:TABSIZ];
00200 BOOLEAN ER;
00210
00220 STRING PROCEDURE HEADER;
00230 BEGIN "HEADER"
00240 STRING H1; INTEGER I,J,K;
00250 IF HCOUNT>0 THEN BEGIN HCOUNT←HCOUNT-1; HINCNT←HINCNT+1;
00260 RETURN(PREHINT) END ELSE WHILE HCOUNT=0 DO BEGIN "XX"
00270 I←LFILE[HINDEX]; K←LDB(POINT(12,I,23)); J←SEGC-K;
00280 IF I=0 THEN BEGIN PREHINT←"NU"; HCOUNT←999; RETURN(PREHINT) END;
00290 IF J ≥ 0 THEN BEGIN "LATCH"
00300 H1←CVXSTR(LDB(POINT(12,I,11)) LSH 24);
00310 IF H1≠0 THEN BEGIN
00320 PREHINT←H1; HCOUNT←LDB(POINT(12,I,35));
00330 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; HINCNT←HINCNT+1;
00340 RETURN(PREHINT); DONE END
00350 ELSE BEGIN PREHINT←"NU"; HCOUNT←LDB(POINT(12,I,35));
00360 HCOUNT←HCOUNT-J; HINDEX←HINDEX+1; RETURN(PREHINT); DONE; END;
00370 END "LATCH";
00380 PREHINT←"NU"; RETURN(PREHINT); END "XX";
00390 END "HEADER";
00400
00410 PROCEDURE SMOOTH;
00420 BEGIN "SMOOTH"
00430
00440 INTEGER ARRAY X,D[0:3];
00450 INTEGER P,Q;
00460
00470 X[0]←K LSH -(N1[1]+N1[2]+N1[3]);
00480 X[1]←(K LSH -(N1[2]+N1[3])) LAND ('377 LSH (N1[1]-8));
00490 X[2]←(K LSH -N1[3]) LAND ('377 LSH (N1[2]-8));
00500 X[3]←K LAND ('377 LSH (N1[3]-8));
00510
00520 D[0]←1 LSH (N1[1]+N1[2]+N1[3]);
00530 D[1]←1 LSH (N1[2]+N1[3]);
00540 D[2]←1 LSH N1[3]; ⊂ Not used if N1[2]=0;
00550 D[3]←1; ⊂ Not used and having no meaning if N1[3]=0;
00560
00570 FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00580
00590 IF X[P]>0 THEN BEGIN
00600 S1←S1+(LDB(POINT(9,RES[K-D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],8));
00610 S2←S2+(LDB(POINT(9,RES[K-D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],17));
00620 S3←S3+(LDB(POINT(9,RES[K-D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],26));
00630 S4←S4+(LDB(POINT(9,RES[K-D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]],35));
00640 END;
00650
00660 IF X[P]<(1 LSH N1[P])-1 THEN BEGIN
00670 S1←S1+(LDB(POINT(9,RES[K+D[P]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],8));
00680 S2←S2+(LDB(POINT(9,RES[K+D[P]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],17));
00690 S3←S3+(LDB(POINT(9,RES[K+D[P]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],26));
00700 S4←S4+(LDB(POINT(9,RES[K+D[P]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]],35));
00710 END; END;
00720
00730
00740 SUM←S1+S2+S3+S4;
00750 IF SUM≠0 THEN SMOCNT←SMOCNT+1 ELSE BEGIN
00760
00770 FOR P←0 STEP 1 UNTIL 3 DO IF N1[P]≠0 THEN BEGIN
00780
00790
00800 IF X[P]>0 THEN FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
00820
00830 IF X[Q]>0 THEN BEGIN
00840 S1←S1+(LDB(POINT(9,RES[K-D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],8));
00850 S2←S2+(LDB(POINT(9,RES[K-D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],17));
00860 S3←S3+(LDB(POINT(9,RES[K-D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],26));
00870 S4←S4+(LDB(POINT(9,RES[K-D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]-D[Q]],35));
00880 END;
00890
00900 IF X[Q]<(1 LSH N1[Q])-1 THEN BEGIN
00910 S1←S1+(LDB(POINT(9,RES[K-D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],8));
00920 S2←S2+(LDB(POINT(9,RES[K-D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],17));
00930 S3←S3+(LDB(POINT(9,RES[K-D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],26));
00940 S4←S4+(LDB(POINT(9,RES[K-D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]+D[Q]],35));
00950 END; END;
00960
00970 IF X[P]>1 THEN BEGIN
00980 S1←S1+(LDB(POINT(9,RES[K-D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],8));
00990 S2←S2+(LDB(POINT(9,RES[K-D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],17));
01000 S3←S3+(LDB(POINT(9,RES[K-D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],26));
01010 S4←S4+(LDB(POINT(9,RES[K-D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L-D[P]*2],35));
01020 END;
01030
01040
01050 IF X[P]<(1 LSH N1[P])-1 THEN
01060 FOR Q←P+1 STEP 1 UNTIL 3 DO IF N1[Q]≠0 THEN BEGIN
01070
01080 IF X[Q]>0 THEN BEGIN
01090 S1←S1+(LDB(POINT(9,RES[K+D[P]-D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],8));
01100 S2←S2+(LDB(POINT(9,RES[K+D[P]-D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],17));
01110 S3←S3+(LDB(POINT(9,RES[K+D[P]-D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],26));
01120 S4←S4+(LDB(POINT(9,RES[K+D[P]-D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]-D[Q]],35));
01130 END;
01140
01150 IF X[Q]<(1 LSH N1[Q])-1 THEN BEGIN
01160 S1←S1+(LDB(POINT(9,RES[K+D[P]+D[Q]],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],8));
01170 S2←S2+(LDB(POINT(9,RES[K+D[P]+D[Q]],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],17));
01180 S3←S3+(LDB(POINT(9,RES[K+D[P]+D[Q]],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],26));
01190 S4←S4+(LDB(POINT(9,RES[K+D[P]+D[Q]],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]+D[Q]],35));
01200 END; END;
01210
01220 IF X[P]<(1 LSH N1[P])-2 THEN BEGIN
01230 S1←S1+(LDB(POINT(9,RES[K+D[P]*2],8)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],8));
01240 S2←S2+(LDB(POINT(9,RES[K+D[P]*2],17)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],17));
01250 S3←S3+(LDB(POINT(9,RES[K+D[P]*2],26)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],26));
01260 S4←S4+(LDB(POINT(9,RES[K+D[P]*2],35)) LSH 5)+LDB(POINT(9,LRN[L+D[P]*2],35));
01270 END;
01280
01290 END;
01300
01310 SUM←S1+S2+S3+S4;
01320 IF SUM≠0 THEN SMCNT2←SMCNT2+1;
01330 END;
01340
01350 IF SUM=0 THEN BEGIN ZCNT←ZCNT+1; S1←S2←S3←S4←'200; SUM←'1000; END;
01360
01370 END "SMOOTH";
01380
01390 PROCEDURE UPDATE;
01400 BEGIN "UPDATE"
01410
01420 OUTSTR(CRLF);
01430 CLOSE(CHAN2); OPEN(CHAN2,"DSK",'10,10,0,0,0,EOF);
01440 LOOKUP(CHAN2,"RES.DAT",RFLAG);
01450 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,0,10,0,0,0);
01460 ENTER(CHAN3,"RES.NEW",0);
01470 CLOSE(CHAN6); OPEN(CHAN6,"DSK",'10,0,10,0,0,0);
01480 ENTER(CHAN6,"USE.DAT",0);
01490 SETFORMAT(3,0);
01500
01510 FOR I←0 STEP 1 UNTIL TABNUM DO BEGIN
01520 IF NAMES[I]=0 THEN DONE;
01530 J←I*TABSIZ;
01540 N1[0]←LDB(POINT(3,IN1[I],11));
01550 N1[1]←LDB(POINT(3,IN2[I],11));
01560 N1[2]←LDB(POINT(3,IN3[I],11));
01570 N1[3]←LDB(POINT(3,IN4[I],11));
01580
01590 FOR K←0 STEP 1 UNTIL TABSIZ-1 DO RES[K]←0;
01600 ARRYIN(CHAN2,RES[0],TABSIZ);
01610
01620 FOR K←0 STEP 1 UNTIL TABSIZ-1 DO BEGIN
01630 L←J+K;
01640
01650 NEW←LDB(POINT(9,LRN[L],8));
01660 OLD←LDB(POINT(9,RES[K],8));
01670 S1←(OLD LSH 5)+NEW;
01680
01690 NEW←LDB(POINT(9,LRN[L],17));
01700 OLD←LDB(POINT(9,RES[K],17));
01710 S2←(OLD LSH 5)+NEW;
01720
01730 NEW←LDB(POINT(9,LRN[L],26));
01740 OLD←LDB(POINT(9,RES[K],26));
01750 S3←(OLD LSH 5)+NEW;
01760
01770 NEW←LDB(POINT(9,LRN[L],35));
01780 OLD←LDB(POINT(9,RES[K],35));
01790 S4←(OLD LSH 5)+NEW;
01800
01810 RES[K]←((S1 LSH -5) LSH 27) + ((S2 LSH -5) LSH 18)
01820 + ((S3 LSH -5) LSH 9) + (S4 LSH -5);
01830 LRN[L]←LRN[L] LAND '037037037037;
01840
01850 SUM←S1+S2+S3+S4;
01860 IF SUM=0 THEN SMOOTH;
01870
01880 S1←(S1 LSH 9)%SUM; S2←(S2 LSH 9)%SUM;
01890 S3←(S3 LSH 9)%SUM; S4←(S4 LSH 9)%SUM;
01900 IF S1=512 THEN S1←511 ELSE IF S2=512 THEN S2←511 ELSE
01910 IF S3=512 THEN S3←511 ELSE IF S4=512 THEN S4←511;
01920 USE[K]←(S1 LSH 27)+(S2 LSH 18)+(S3 LSH 9) +S4;
01930 END;
01940
01950 ARRYOUT(CHAN3,RES[0],TABSIZ); ARRYOUT(CHAN6,USE[0],TABSIZ);
01960 OUTSTR("Table "&CVXSTR(NAMES[I])&TB
01970 &CVS(SMOCNT)&" near-smoothed "
01980 &CVS(SMCNT2)&" far-smoothed "&CVS(ZCNT)&" averaged."&CRLF);
01990 SMOCNT←smcnt2←ZCNT←0;
02000 END;
02010 ⊂ CLOSE(CHAN2); RENAME(CHAN2,"",0,0); RELEASE(CHAN2);
02020 CLOSE(CHAN3); OPEN(CHAN3,"DSK",'10,10,0,0,0,EOF);
02030 LOOKUP(CHAN3,"RES.NEW",0);RENAME(CHAN3,"RES.DAT",0,0); RELEASE(CHAN3);
02040 CLOSE(CHAN6);
02050 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,0,10,0,0,EOF);
02060 ENTER(CHAN1,"LRN.DAT",0);
02070 ARRYOUT(CHAN1,LRN[0],TABTOT); CLOSE(CHAN1);
02080 OUTSTR("Update completed."&CRLF);
02090 END "UPDATE";
02100
00010 STDBRK(1);
00020 SETBREAK(14,"∃",NULL,"INS");
00030
00040 FILEL←"LIST28";
00050 FILEI←"TOO1.DAT[1,THO]";
00060 CHAN1←1; CHAN2←2; CHAN3←3; CHAN4←4; CHAN5←5; CHAN6←6;
00070 HEADIN;
00080 FOR I←0 STEP 1 UNTIL 15 DO IF NAMES[I]=0 THEN DONE; TABTOT←I*TABSIZ;
00090 OUTSTR("TABTOT= "&CVS(TABTOT)&CRLF);
00100 FLAG←0; SIG(P); FLAG←-1; ⊂ To preset addrssses in SIG;
00110 CLOSE(CHAN1); OPEN(CHAN1,"DSK",'10,10,0,0,0,EOF);
00120 LOOKUP(CHAN1,"LRN.DAT",0);ARRYIN(CHAN1,LRN[0],TABTOT);CLOSE(CHAN1);
00130 RELEASE(CHAN1);
00140 FILEL←STRIN("Data file list (LIST28) = ");
00150 IF FILEL="" THEN FILEL←"LIST28";
00160 CLOSE(CHAN5); OPEN(CHAN5,"DSK",1,2,0,3500,BRK,EOFA);
00170 LOOKUP(CHAN5,FILEL,ER);
00180 WHILE ER DO BEGIN OUTSTR(CRLF&"Can't find "&FILEL&" File = ");
00190 LOOKUP(CHAN5,FILEL←INCHWL,ER); END; EOFA←0;
00200 FILLST←INPUT(CHAN5,14); EOFA←0; RL←0;
00210 WHILE EOFA=0 DO BEGIN "LISTREAD"
00220 HINDEX←21; HCOUNT←HINCNT←0;
00230 FILEI←SCAN(FILLST,1,J); IF FILEI="" THEN DONE;
00240
00250 CLOSE(CHAN4); OPEN(CHAN4,"DSK",'10,10,0,0,0,EOF);
00260 LOOKUP(CHAN4,FILEI,ER);
00265 IF EOF≠0 THEN DONE;
00270 ARRYIN(CHAN4,LFILE[0],'200); ⊂ Input header;
00280 SEGTOT←(LFILE[0]*6)%256;
00290 OUTSTR(FILEI&" "&CVS(SEGTOT)&" seg. ");
00300 ARRYIN(CHAN4,INDATA[0],SEGTOT*4); CLOSE(CHAN4);
00310 BPT←POINT(6,INDATA[0],-1); HINDEX←21; HCOUNT←HINCNT←0;
00320
00330 FOR SEGC←1 STEP 1 UNTIL SEGTOT DO BEGIN
00340 READ1←HEADER;
00350 J←CVSIX(READ1);
00360 FOR I←0 STEP 1 UNTIL 63 DO BEGIN IF PHLIST[I]=0 THEN BEGIN
00370 OUTSTR("Hint not identified for segment = "&READ1
00380 &" " &CVS(SEGC)&CRLF);DONE END;
00390 IF PHLIST[I]=J THEN BEGIN HINT←HLIST[I]; PHW←J; DONE ; END;
00400 END;
00410
00420 FOR P←0 STEP 1 UNTIL 23 DO INDAT[P]←ILDB(BPT);
00430 IF PHW≠CVSIX("NU") THEN SIG(P);
00440 END;
00450
00460 OUTSTR(CVS(HINCNT)&" hints . ");
00470 IF RL=0 THEN RL←1 ELSE BEGIN RL←0; OUTSTR(CRLF); END;
00480 UPDATE;
00490 IF EOFA≠0 THEN DONE;
00500 END "LISTREAD";
00510 RELEASE(CHAN1); RELEASE(CHAN2); RELEASE(CHAN3); RELEASE(CHAN6);
00520
00530 OUTSTR("Tables saved"&CRLF);
00540 END "SAY";